indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages ---------------------------------------------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: Ignoring 1 observations p2## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.p_combined <-
plotly::subplot(p2,p1, # plots to combine, top to bottom
nrows = 2,
heights = c(.6,.4), # relative heights of the two plots
shareX = TRUE, # plots will share an X axis
titleY = TRUE
) %>%
# create a vertical "spike line" to compare data across 2 plots
plotly::layout(
xaxis = list(
spikethickness = 1,
spikedash = "dot",
spikecolor = "black",
spikemode = "across+marker",
spikesnap = "cursor"
),
yaxis = list(spikethickness = 0)
)## Warning: Ignoring 1 observationsp_combinedSave the plot to pull into the index
#save(p_combined, file = "./plotly_fig.rda")Save an htmlwidget for website embedding
#htmlwidgets::saveWidget(p_combined, "plotly_fig.html")#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")#build a function here to make smooth frames so we don't repeat everything in huge loops
#FOR INDIVIDUAL FIGURES ONLY
make_n1_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")
return(smooth_n1)
}
make_n2_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")
return(smooth_n1)
}
#run frames through the functions
wrfa_smooth_n1 <- make_n1_smooth_frame(wrf_a_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n1 <- make_n1_smooth_frame(wrf_b_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n1 <- make_n1_smooth_frame(wrf_c_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfa_smooth_n2 <- make_n2_smooth_frame(wrf_a_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n2 <- make_n2_smooth_frame(wrf_b_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n2 <- make_n2_smooth_frame(wrf_c_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#get max date
maxdate <- max(wrfa_smooth_n1$date)
mindate <- min(wrfa_smooth_n1$date)Build loess smoothing figures figures
#COMBINED FIGURE ONLY
#create smoothing data frames
#n1
smooth_n1 <- only_n1 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#n2
smooth_n2 <- only_n2 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#**************************************COMBINED PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1 <- ggplot(smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2 <- ggplot(smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1## `geom_smooth()` using formula 'y ~ x'
fit_n1## [1] 11.25620 11.38418 11.50944 11.63126 11.74894 11.86175 11.96899 12.06994
## [9] 12.16507 12.25555 12.34168 12.42377 12.50215 12.57711 12.64898 12.71634
## [17] 12.77787 12.83399 12.88510 12.93162 12.97397 13.01257 13.04784 13.08018
## [25] 13.11001 13.13775 13.16383 13.18864 13.21261 13.22798 13.22961 13.22188
## [33] 13.20914 13.19578 13.18616 13.18464 13.17997 13.15969 13.12641 13.08273
## [41] 13.03126 12.97458 12.91530 12.85603 12.79936 12.74789 12.70423 12.67098
## [49] 12.65072 12.64608 12.65183 12.66083 12.67280 12.68744 12.70446 12.72358
## [57] 12.74450 12.77370 12.81645 12.87072 12.93445 13.00558 13.08207 13.16187
## [65] 13.24292 13.32316 13.40055 13.47304 13.53858 13.59510 13.64056 13.68320
## [73] 13.73164 13.78444 13.84016 13.89736 13.95458 14.01038 14.06332 14.11196
## [81] 14.15484 14.19053 14.21758 14.23454 14.23997 14.23066 14.20729 14.17427
## [89] 14.13601 14.09692 14.06140 14.03385 14.00450 13.96207 13.90865 13.84635
## [97] 13.77728 13.70354 13.62725 13.55051 13.47542 13.40410 13.33866 13.28120
## [105] 13.23382 13.19864 13.16876 13.13701 13.10507 13.07465 13.04741 13.02506
## [113] 13.00928 12.99784 12.98755 12.97864 12.97135 12.96594 12.96262 12.96165
## [121] 12.96326 12.96770 12.97520 12.98600 13.00034 13.01847 13.04061 13.06588
## [129] 13.09337 13.12332 13.15600 13.19164 13.23051 13.27284 13.31865 13.36770
## [137] 13.41990 13.47518 13.53342 13.59455 13.65848 13.72512#n2
extract_n2## `geom_smooth()` using formula 'y ~ x'
fit_n2## [1] 11.01877 11.18829 11.35391 11.51501 11.67095 11.82109 11.96479 12.10143
## [9] 12.23140 12.35574 12.47472 12.58862 12.69771 12.80227 12.90258 12.99738
## [17] 13.08549 13.16727 13.24311 13.31338 13.37846 13.43871 13.49452 13.54625
## [25] 13.59429 13.63901 13.68077 13.71997 13.75696 13.78560 13.80172 13.80874
## [33] 13.81007 13.80911 13.80927 13.81395 13.81159 13.79030 13.75301 13.70265
## [41] 13.64215 13.57444 13.50245 13.42910 13.35733 13.29007 13.23024 13.18078
## [49] 13.14461 13.12467 13.11094 13.09317 13.07390 13.05567 13.04104 13.03255
## [57] 13.03274 13.04510 13.07017 13.10605 13.15087 13.20274 13.25977 13.32008
## [65] 13.38179 13.44301 13.50186 13.55645 13.60490 13.64532 13.67583 13.70316
## [73] 13.73464 13.76932 13.80620 13.84434 13.88274 13.92044 13.95648 13.98987
## [81] 14.01965 14.04484 14.06448 14.07759 14.08320 14.07835 14.06301 14.04059
## [89] 14.01448 13.98809 13.96482 13.94809 13.93245 13.91077 13.88393 13.85281
## [97] 13.81827 13.78119 13.74245 13.70291 13.66346 13.62496 13.58830 13.55434
## [105] 13.52395 13.49802 13.48125 13.47474 13.47394 13.47430 13.47128 13.46033
## [113] 13.43689 13.40597 13.37536 13.34478 13.31392 13.28248 13.25014 13.21662
## [121] 13.18161 13.14481 13.10591 13.06461 13.02061 12.97360 12.92330 12.87089
## [129] 12.81757 12.76299 12.70681 12.64870 12.58830 12.52529 12.45965 12.39167
## [137] 12.32144 12.24907 12.17463 12.09822 12.01993 11.93985#assign fits to a vector
n1_trend <- fit_n1
n2_trend <- fit_n2
#extract y min and max for each
limits_n1 <- ggplot_build(extract_n1)$data## `geom_smooth()` using formula 'y ~ x'limits_n1 <- as.data.frame(limits_n1)
n1_ymin <- limits_n1$ymin
n1_ymax <- limits_n1$ymax
limits_n2 <- ggplot_build(extract_n2)$data## `geom_smooth()` using formula 'y ~ x'limits_n2 <- as.data.frame(limits_n2)
n2_ymin <- limits_n2$ymin
n2_ymax <- limits_n2$ymax
#reassign dataframes (just to be safe)
work_n1 <- smooth_n1
work_n2 <- smooth_n2
#fill in missing dates to smooth fits
work_n1 <- work_n1 %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1 <- work_n1$date
work_n2 <- work_n2 %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2 <- work_n2$date
#create a new smooth dataframe to layer
smooth_frame_n1 <- data.frame(date_vec_n1, n1_trend, n1_ymin, n1_ymax)
smooth_frame_n2 <- data.frame(date_vec_n2, n2_trend, n2_ymin, n2_ymax)#make plotlys
#**************************************COMBINED PLOT**********************************************
#plot smooth frames
p3 <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1, y = ~n1_trend,
data = smooth_frame_n1,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1,
'</br> Median Log Copies: ', round(n1_trend, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_lines(x = ~date_vec_n2, y = ~n2_trend,
data = smooth_frame_n2,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2,
'</br> Median Log Copies: ', round(n2_trend, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1, ymin = ~n1_ymin, ymax = ~n1_ymax,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymax, digits = 2),
'</br> Min Log Copies: ', round(n1_ymin, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2, ymin = ~n2_ymin, ymax = ~n2_ymax,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymax, digits = 2),
'</br> Min Log Copies: ', round(n2_ymin, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_ymin), yend = ~max(n1_ymax),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_ymin), yend = ~max(n1_ymax),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_ymin), yend = ~max(n1_ymax),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p3Create final trend plot by stacking with epidemic curve
smooth_extracttest <-
plotly::subplot(p3,p1, # plots to combine, top to bottom
nrows = 2,
heights = c(.6,.4), # relative heights of the two plots
shareX = TRUE, # plots will share an X axis
titleY = TRUE
) %>%
# create a vertical "spike line" to compare data across 2 plots
plotly::layout(
xaxis = list(
spikethickness = 1,
spikedash = "dot",
spikecolor = "black",
spikemode = "across+marker",
spikesnap = "cursor"
),
yaxis = list(spikethickness = 0)
)## Warning: Ignoring 1 observationssmooth_extracttest#save(smooth_extracttest, file = "./smooth_extracttest.rda")This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1a <- ggplot(wrfa_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2a <- ggplot(wrfa_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1a## `geom_smooth()` using formula 'y ~ x'
fit_n1a## [1] 11.16540 11.23377 11.30048 11.36508 11.42711 11.48611 11.54162 11.59320
## [9] 11.64093 11.68548 11.72721 11.76651 11.80375 11.83930 11.87354 11.90515
## [17] 11.93279 11.95682 11.97759 11.99546 12.01079 12.02394 12.03525 12.04509
## [25] 12.05381 12.06177 12.06932 12.07683 12.08464 12.08194 12.06192 12.03093
## [33] 11.99535 11.96152 11.93582 11.92460 11.92028 11.91175 11.90012 11.88650
## [41] 11.87197 11.85766 11.84465 11.83406 11.82698 11.82453 11.82779 11.83788
## [49] 11.85591 11.88296 11.92063 11.96785 12.02171 12.07933 12.13780 12.19424
## [57] 12.24574 12.30171 12.37189 12.45388 12.54527 12.64367 12.74667 12.85188
## [65] 12.95688 13.05929 13.15670 13.24671 13.32692 13.39492 13.44832 13.49681
## [73] 13.55056 13.60790 13.66715 13.72663 13.78466 13.83959 13.88971 13.93338
## [81] 13.96889 13.99459 14.00880 14.00983 13.99602 13.95337 13.87710 13.77938
## [89] 13.67235 13.56817 13.47899 13.41697 13.36169 13.28692 13.19604 13.09248
## [97] 12.97962 12.86087 12.73963 12.61931 12.50330 12.39501 12.29784 12.21519
## [105] 12.15046 12.10706 12.07804 12.05409 12.03503 12.02070 12.01093 12.00555
## [113] 12.00440 12.00731 12.01411 12.02463 12.03872 12.05619 12.07688 12.10064
## [121] 12.12765 12.15840 12.19308 12.23190 12.27507 12.32281 12.37532 12.43241
## [129] 12.49375 12.55930 12.62905 12.70298 12.78105 12.86326 12.94957 13.03996
## [137] 13.13441 13.23290 13.33541 13.44191 13.55238 13.66679#n2
extract_n2a## `geom_smooth()` using formula 'y ~ x'
fit_n2a## [1] 10.66832 10.86229 11.05093 11.23376 11.41031 11.58009 11.74261 11.89739
## [9] 12.04451 12.18461 12.31809 12.44532 12.56671 12.68264 12.79350 12.89801
## [17] 12.99485 13.08437 13.16694 13.24291 13.31263 13.37646 13.43476 13.48787
## [25] 13.53616 13.57998 13.61968 13.65562 13.68816 13.70913 13.71322 13.70509
## [33] 13.68938 13.67074 13.65381 13.64326 13.62755 13.59403 13.54559 13.48516
## [41] 13.41563 13.33992 13.26095 13.18162 13.10484 13.03352 12.97057 12.91892
## [49] 12.88145 12.86109 12.84872 12.83445 12.82002 12.80718 12.79768 12.79327
## [57] 12.79569 12.81004 12.83875 12.87956 12.93021 12.98846 13.05206 13.11876
## [65] 13.18629 13.25242 13.31488 13.37143 13.41981 13.45778 13.48308 13.50448
## [73] 13.53130 13.56208 13.59536 13.62971 13.66365 13.69575 13.72454 13.74858
## [81] 13.76641 13.77658 13.77763 13.76812 13.74658 13.70096 13.62713 13.53558
## [89] 13.43681 13.34131 13.25956 13.20205 13.15215 13.08793 13.01198 12.92689
## [97] 12.83523 12.73958 12.64253 12.54665 12.45453 12.36875 12.29189 12.22653
## [105] 12.17526 12.14065 12.12010 12.10841 12.10426 12.10631 12.11325 12.12375
## [113] 12.13648 12.15012 12.16335 12.17484 12.18326 12.18730 12.18562 12.17690
## [121] 12.16562 12.15664 12.14927 12.14279 12.13651 12.12972 12.12170 12.11291
## [129] 12.10426 12.09571 12.08724 12.07883 12.07044 12.06204 12.05362 12.04514
## [137] 12.03658 12.02790 12.01909 12.01011 12.00094 11.99156#assign fits to a vector
n1_trenda <- fit_n1a
n2_trenda <- fit_n2a
#extract y min and max for each
limits_n1a <- ggplot_build(extract_n1a)$data## `geom_smooth()` using formula 'y ~ x'limits_n1a <- as.data.frame(limits_n1a)
n1_ymina <- limits_n1a$ymin
n1_ymaxa <- limits_n1a$ymax
limits_n2a <- ggplot_build(extract_n2a)$data## `geom_smooth()` using formula 'y ~ x'limits_n2a <- as.data.frame(limits_n2a)
n2_ymina <- limits_n2a$ymin
n2_ymaxa <- limits_n2a$ymax
#reassign dataframes (just to be safe)
work_n1a <- wrfa_smooth_n1
work_n2a<- wrfa_smooth_n1
#fill in missing dates to smooth fits
work_n1a <- work_n1a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1a <- work_n1a$date
work_n2a <- work_n2a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2a <- work_n2a$date
#create a new smooth dataframe to layer
smooth_frame_n1a <- data.frame(date_vec_n1a, n1_trenda, n1_ymina, n1_ymaxa)
smooth_frame_n2a <- data.frame(date_vec_n2a, n2_trenda, n2_ymina, n2_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1a, y = ~n1_trenda,
data = smooth_frame_n1a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a,
'</br> Median Log Copies: ', round(n1_trenda, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2a, y = ~n2_trenda,
data = smooth_frame_n2a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a,
'</br> Median Log Copies: ', round(n2_trenda, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1a, ymin = ~n1_ymina, ymax = ~n1_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n1_ymina, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2a, ymin = ~n2_ymina, ymax = ~n2_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n2_ymina, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1b <- ggplot(wrfb_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2b <- ggplot(wrfb_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1b## `geom_smooth()` using formula 'y ~ x'
fit_n1b## [1] 10.88831 10.98852 11.08647 11.18148 11.27284 11.35986 11.44185 11.51810
## [9] 11.58911 11.65599 11.71905 11.77857 11.83484 11.88816 11.93882 11.98541
## [17] 12.02661 12.06284 12.09451 12.12205 12.14588 12.16642 12.18410 12.19932
## [25] 12.21252 12.22411 12.23451 12.24415 12.25344 12.25402 12.24042 12.21737
## [33] 12.18963 12.16195 12.13908 12.12576 12.11010 12.07885 12.03473 11.98046
## [41] 11.91877 11.85238 11.78400 11.71635 11.65217 11.59416 11.54506 11.50758
## [49] 11.48443 11.47836 11.48464 11.49621 11.51222 11.53183 11.55418 11.57844
## [57] 11.60376 11.63653 11.68248 11.73973 11.80641 11.88064 11.96056 12.04429
## [65] 12.12996 12.21570 12.29963 12.37988 12.45459 12.52187 12.57986 12.63886
## [73] 12.70893 12.78781 12.87324 12.96295 13.05470 13.14622 13.23525 13.31954
## [81] 13.39682 13.46484 13.52133 13.56404 13.59072 13.60391 13.60869 13.60652
## [89] 13.59891 13.58732 13.57324 13.55815 13.53334 13.49093 13.43366 13.36425
## [97] 13.28546 13.20001 13.11065 13.02010 12.93112 12.84643 12.76878 12.70090
## [105] 12.64552 12.60540 12.56757 12.52056 12.46930 12.41871 12.37372 12.33926
## [113] 12.32025 12.31080 12.30203 12.29440 12.28839 12.28444 12.28302 12.28458
## [121] 12.28960 12.29853 12.31183 12.32997 12.35339 12.38258 12.41798 12.45758
## [129] 12.49953 12.54450 12.59318 12.64625 12.70440 12.76830 12.83793 12.91269
## [137] 12.99235 13.07670 13.16554 13.25864 13.35580 13.45681#n2
extract_n2b## `geom_smooth()` using formula 'y ~ x'
fit_n2b## [1] 10.55486 10.68774 10.81740 10.94341 11.06532 11.18272 11.29515 11.40218
## [9] 11.50417 11.60185 11.69535 11.78478 11.87026 11.95193 12.02991 12.10306
## [17] 12.17042 12.23234 12.28918 12.34130 12.38904 12.43277 12.47284 12.50960
## [25] 12.54341 12.57463 12.60361 12.63070 12.65626 12.67467 12.68215 12.68182
## [33] 12.67680 12.67023 12.66522 12.66489 12.65928 12.63800 12.60352 12.55831
## [41] 12.50485 12.44561 12.38308 12.31971 12.25800 12.20041 12.14942 12.10750
## [49] 12.07713 12.06078 12.04052 12.00219 11.95394 11.90393 11.86030 11.83121
## [57] 11.82482 11.84101 11.87282 11.91815 11.97487 12.04087 12.11404 12.19226
## [65] 12.27343 12.35541 12.43611 12.51341 12.58519 12.64934 12.70375 12.76152
## [73] 12.83508 12.92131 13.01710 13.11933 13.22487 13.33061 13.43342 13.53019
## [81] 13.61779 13.69311 13.75303 13.79442 13.81417 13.81411 13.80039 13.77634
## [89] 13.74531 13.71066 13.67572 13.64384 13.60338 13.54259 13.46466 13.37278
## [97] 13.27015 13.15996 13.04540 12.92967 12.81595 12.70745 12.60734 12.51884
## [105] 12.44512 12.38938 12.34657 12.30865 12.27435 12.24241 12.21157 12.18055
## [113] 12.14808 12.11497 12.08288 12.05190 12.02212 11.99361 11.96647 11.94077
## [121] 11.91660 11.89404 11.87317 11.85408 11.83686 11.82158 11.80832 11.79656
## [129] 11.78589 11.77659 11.76895 11.76327 11.75982 11.75891 11.76048 11.76426
## [137] 11.77014 11.77799 11.78771 11.79919 11.81232 11.82697#assign fits to a vector
n1_trendb <- fit_n1b
n2_trendb <- fit_n2b
#extract y min and max for each
limits_n1b <- ggplot_build(extract_n1b)$data## `geom_smooth()` using formula 'y ~ x'limits_n1b <- as.data.frame(limits_n1b)
n1_yminb <- limits_n1b$ymin
n1_ymaxb <- limits_n1b$ymax
limits_n2b <- ggplot_build(extract_n2b)$data## `geom_smooth()` using formula 'y ~ x'limits_n2b <- as.data.frame(limits_n2b)
n2_yminb <- limits_n2b$ymin
n2_ymaxb <- limits_n2b$ymax
#reassign dataframes (just to be safe)
work_n1b <- wrfb_smooth_n1
work_n2b<- wrfb_smooth_n1
#fill in missing dates to smooth fits
work_n1b <- work_n1b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1b <- work_n1b$date
work_n2b <- work_n2b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2b <- work_n2b$date
#create a new smooth dataframe to layer
smooth_frame_n1b <- data.frame(date_vec_n1b, n1_trendb, n1_yminb, n1_ymaxb)
smooth_frame_n2b <- data.frame(date_vec_n2b, n2_trendb, n2_yminb, n2_ymaxb)
#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1b, y = ~n1_trendb,
data = smooth_frame_n1b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b,
'</br> Median Log Copies: ', round(n1_trendb, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2b, y = ~n2_trendb,
data = smooth_frame_n2b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b,
'</br> Median Log Copies: ', round(n2_trendb, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1b, ymin = ~n1_yminb, ymax = ~n1_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n1_yminb, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2b, ymin = ~n2_yminb, ymax = ~n2_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n2_yminb, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** Does not work until raw data fixed #add trendlines #extract data from geom_smooth #n1 extract # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1c <- ggplot(wrfc_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1c<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 128)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2c <- ggplot(wrfc_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2c<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 128)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1c## `geom_smooth()` using formula 'y ~ x'
fit_n1c## [1] 11.05907 11.13499 11.20864 11.27993 11.34873 11.41495 11.47846 11.53917
## [9] 11.59712 11.65249 11.70535 11.75576 11.80379 11.84951 11.89299 11.93429
## [17] 11.97350 12.01066 12.04586 12.07916 12.11063 12.14034 12.16708 12.18979
## [25] 12.20879 12.22438 12.23687 12.24657 12.25379 12.25883 12.26201 12.26362
## [33] 12.26399 12.26341 12.26219 12.26065 12.25657 12.24805 12.23586 12.22077
## [41] 12.20355 12.18497 12.16580 12.14681 12.12877 12.11244 12.09861 12.08803
## [49] 12.08148 12.07973 12.08837 12.10932 12.13784 12.16916 12.19855 12.22126
## [57] 12.23255 12.23606 12.23851 12.23978 12.23972 12.23819 12.23506 12.23018
## [65] 12.22342 12.21465 12.20371 12.19048 12.17482 12.15658 12.13564 12.11540
## [73] 12.09877 12.08483 12.07266 12.06134 12.04996 12.03760 12.02333 12.00624
## [81] 11.98541 11.95992 11.92885 11.89129 11.84632 11.77531 11.66927 11.54170
## [89] 11.40613 11.27606 11.16502 11.08651 11.02649 10.96285 10.89696 10.83020
## [97] 10.76397 10.69965 10.63861 10.58224 10.53193 10.48906 10.45501 10.43117
## [105] 10.41892 10.41964 10.43068 10.44828 10.47220 10.50221 10.53804 10.57948
## [113] 10.62626 10.67814 10.73488 10.79625 10.86198 10.93185 11.00560 11.08299
## [121] 11.16445 11.25054 11.34126 11.43663 11.53663 11.64127 11.75056 11.86448#n2
extract_n2c## `geom_smooth()` using formula 'y ~ x'
fit_n2c## [1] 11.53956 11.57288 11.60547 11.63682 11.66645 11.69386 11.71857 11.74007
## [9] 11.75825 11.77353 11.78622 11.79666 11.80515 11.81204 11.81762 11.82224
## [17] 11.82620 11.82983 11.83346 11.83740 11.84198 11.84751 11.84994 11.84569
## [25] 11.83581 11.82134 11.80334 11.78285 11.76091 11.73859 11.71691 11.69694
## [33] 11.67972 11.66629 11.65771 11.65502 11.65974 11.67209 11.69115 11.71598
## [41] 11.74568 11.77930 11.81594 11.85466 11.89455 11.93468 11.97412 12.01197
## [49] 12.04728 12.07915 12.13729 12.24066 12.37216 12.51469 12.65116 12.76446
## [57] 12.83751 12.88055 12.91540 12.94232 12.96157 12.97341 12.97811 12.97591
## [65] 12.96708 12.95189 12.93058 12.90343 12.87068 12.83261 12.78947 12.73740
## [73] 12.67363 12.60009 12.51871 12.43142 12.34015 12.24682 12.15336 12.06170
## [81] 11.97376 11.89147 11.81677 11.75157 11.69781 11.64662 11.58974 11.52997
## [89] 11.47014 11.41305 11.36152 11.31837 11.28530 11.26130 11.24508 11.23537
## [97] 11.23090 11.23038 11.23254 11.23610 11.23978 11.24230 11.24239 11.23878
## [105] 11.23017 11.21530 11.19751 11.18078 11.16474 11.14905 11.13334 11.11727
## [113] 11.10047 11.08260 11.06330 11.04222 11.01900 10.99328 10.96472 10.93296
## [121] 10.89867 10.86282 10.82541 10.78648 10.74607 10.70419 10.66088 10.61617#assign fits to a vector
n1_trendc <- fit_n1c
n2_trendc <- fit_n2c
#extract y min and max for each
limits_n1c <- ggplot_build(extract_n1c)$data## `geom_smooth()` using formula 'y ~ x'limits_n1c <- as.data.frame(limits_n1c)
n1_yminc <- limits_n1c$ymin
n1_ymaxc <- limits_n1c$ymax
limits_n2c <- ggplot_build(extract_n2c)$data## `geom_smooth()` using formula 'y ~ x'limits_n2c <- as.data.frame(limits_n2c)
n2_yminc <- limits_n2c$ymin
n2_ymaxc <- limits_n2c$ymax
#reassign dataframes (just to be safe)
work_n1c <- wrfc_smooth_n1
work_n2c <- wrfc_smooth_n1
#fill in missing dates to smooth fits
work_n1c <- work_n1c %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1c <- work_n1c$date
work_n2c <- work_n2c %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2c <- work_n2c$date
#create a new smooth dataframe to layer
smooth_frame_n1c <- data.frame(date_vec_n1c, n1_trendc, n1_yminc, n1_ymaxc)
smooth_frame_n2c <- data.frame(date_vec_n2c, n2_trendc, n2_yminc, n2_ymaxc)
#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1c, y = ~n1_trendc,
data = smooth_frame_n1c,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1c,
'</br> Median Log Copies: ', round(n1_trendc, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2c, y = ~n2_trendc,
data = smooth_frame_n2c,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2c,
'</br> Median Log Copies: ', round(n2_trendc, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1c, ymin = ~n1_yminc, ymax = ~n1_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1c, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(n1_yminc, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2c, ymin = ~n2_yminc, ymax = ~n2_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2c, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(n2_yminc, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfc_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfc_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(smooth_frame_n1a, file = "./plotly_objs/smooth_frame_n1a.rda")
save(smooth_frame_n2a, file = "./plotly_objs/smooth_frame_n2a.rda")
save(smooth_frame_n1b, file = "./plotly_objs/smooth_frame_n1b.rda")
save(smooth_frame_n2b, file = "./plotly_objs/smooth_frame_n2b.rda")
save(smooth_frame_n1c, file = "./plotly_objs/smooth_frame_n1c.rda")
save(smooth_frame_n2c, file = "./plotly_objs/smooth_frame_n2c.rda")save(date_vec_n1a, file = "./plotly_objs/date_vec_n1a.rda")
save(date_vec_n2a, file = "./plotly_objs/date_vec_n2a.rda")
save(date_vec_n1b, file = "./plotly_objs/date_vec_n1b.rda")
save(date_vec_n2b, file = "./plotly_objs/date_vec_n2b.rda")
save(date_vec_n1c, file = "./plotly_objs/date_vec_n1c.rda")
save(date_vec_n2c, file = "./plotly_objs/date_vec_n2c.rda")save(n1_ymina, file = "./plotly_objs/n1_ymina.rda")
save(n1_ymaxa, file = "./plotly_objs/n1_ymaxa.rda")
save(n2_ymina, file = "./plotly_objs/n2_ymina.rda")
save(n2_ymaxa, file = "./plotly_objs/n2_ymaxa.rda")
save(n1_yminb, file = "./plotly_objs/n1_yminb.rda")
save(n1_ymaxb, file = "./plotly_objs/n1_ymaxb.rda")
save(n2_yminb, file = "./plotly_objs/n2_yminb.rda")
save(n2_ymaxb, file = "./plotly_objs/n2_ymaxb.rda")
save(n1_yminc, file = "./plotly_objs/n1_yminc.rda")
save(n1_ymaxc, file = "./plotly_objs/n1_ymaxc.rda")
save(n2_yminc, file = "./plotly_objs/n2_yminc.rda")
save(n2_ymaxc, file = "./plotly_objs/n2_ymaxc.rda")